VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsLevel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private d() As Byte
'7=water?
'4-6=arguments(direction etc.)
'0-3=style
'
'0-nothing
'1-floor
'2-???

Private w As Long, h As Long

Public Property Get Width() As Long
Width = w
End Property

Public Property Get Height() As Long
Height = h
End Property

Public Property Get Data(ByVal x As Long, ByVal y As Long) As Byte
Data = d(x, y)
End Property

Public Property Let Data(ByVal x As Long, ByVal y As Long, ByVal n As Byte)
d(x, y) = n
End Property

Public Sub HitTest(x As Single, y As Single, ByVal r As Long, ByVal bStyle As Long, vx As Single, vy As Single, flrStyle As Long)
Dim x1 As Long, x2 As Long, y1 As Long, y2 As Long
Dim i As Long, j As Long
Dim b As Boolean
x1 = (x - r) \ Px
x2 = 1 + (x + r) \ Px
y1 = (y - r) \ Px
y2 = 1 + (y + r) \ Px
If x1 < 1 Then x1 = 1
If x2 > w Then x2 = w
If y1 < 1 Then y1 = 1
If y2 > h Then y2 = h
flrStyle = 0
'debug
Erase xHitTest
For i = x1 To x2
 For j = y2 To y1 Step -1
  b = b Or SingleHitTest(x, y, r, bStyle, i, j, vx, vy, flrStyle)   'bStyle=?
 Next j
Next i
If Not b Then
 For i = x1 To x2
  For j = y2 To y1 Step -1
   SingleHitTestP x, y, r, bStyle, i, j, vx, vy, flrStyle  'bStyle=?
  Next j
 Next i
End If
End Sub

Private Sub SingleHitTestP(x0 As Single, y0 As Single, ByVal r As Long, ByVal bStyle As Long, ByVal x1 As Long, ByVal y1 As Long, vx As Single, vy As Single, flrStyle As Long)
'Dim x As Long, y As Long
Dim st As Long ', v As Single
'x = Round(x0)
'y = Round(y0)
st = d(x1, y1) And &HF
Select Case st
Case 0 'empty
Case 1, 2 'floor,???
 Select Case (d(x1, y1) And &H70) \ &H10
 Case 0
  If PointHitTest(x0, y0, r, (x1 - 1) * Px, (y1 - 1) * Px, 1) Or PointHitTest(x0, y0, r, x1 * Px, (y1 - 1) * Px, 1) Then
   'y0 = (y1 - 1) * Px - Sqr(r * r - v * v)
   flrStyle = st + (d(x1, y1) And &H80)
   pBounceUp bStyle, vy, flrStyle
  ElseIf PointHitTest(x0, y0, r, (x1 - 1) * Px, y1 * Px, 2) Or PointHitTest(x0, y0, r, x1 * Px, y1 * Px, 2) Then
   'y0 = y1 * Px + Sqr(r * r - v * v)
   pBounceDown bStyle, vy
  End If
 Case 1 'TODO:position modify
  If PointHitTest(x0, y0, r, x1 * Px, (y1 - 1) * Px, 1) Or PointHitTest(x0, y0, r, (x1 - 1) * Px, y1 * Px, 1) Then
   'y0 = (y1 - 1) * Px - Sqr(r * r - v * v)
   flrStyle = st + (d(x1, y1) And &H80)
   pBounceUp bStyle, vy, flrStyle
  ElseIf PointHitTest(x0, y0, r, (x1 - 1) * Px, y1 * Px, 2) Or PointHitTest(x0, y0, r, x1 * Px, y1 * Px, 2) Then
   'y0 = y1 * Px + Sqr(r * r - v * v)
   pBounceDown bStyle, vy
  End If
 Case 2 'TODO:position modify
  If PointHitTest(x0, y0, r, (x1 - 1) * Px, (y1 - 1) * Px, 1) Or PointHitTest(x0, y0, r, x1 * Px, y1 * Px, 1) Then
   'y0 = (y1 - 1) * Px - Sqr(r * r - v * v)
   flrStyle = st + (d(x1, y1) And &H80)
   pBounceUp bStyle, vy, flrStyle
  ElseIf PointHitTest(x0, y0, r, (x1 - 1) * Px, y1 * Px, 2) Or PointHitTest(x0, y0, r, x1 * Px, y1 * Px, 2) Then
   'y0 = y1 * Px + Sqr(r * r - v * v)
   pBounceDown bStyle, vy
  End If
 Case 3 'TODO:position modify
  If PointHitTest(x0, y0, r, (x1 - 1) * Px, (y1 - 1) * Px, 1) Or PointHitTest(x0, y0, r, x1 * Px, (y1 - 1) * Px, 1) Then
   'y0 = (y1 - 1) * Px - Sqr(r * r - v * v)
   flrStyle = st + (d(x1, y1) And &H80)
   pBounceUp bStyle, vy, flrStyle
  ElseIf PointHitTest(x0, y0, r, (x1 - 1) * Px, y1 * Px, 2) Or PointHitTest(x0, y0, r, x1 * Px, (y1 - 1) * Px, 2) Then
   'y0 = y1 * Px + Sqr(r * r - v * v)
   pBounceDown bStyle, vy
  End If
 Case 4 'TODO:position modify
  If PointHitTest(x0, y0, r, (x1 - 1) * Px, (y1 - 1) * Px, 1) Or PointHitTest(x0, y0, r, x1 * Px, (y1 - 1) * Px, 1) Then
   'y0 = (y1 - 1) * Px - Sqr(r * r - v * v)
   flrStyle = st + (d(x1, y1) And &H80)
   pBounceUp bStyle, vy, flrStyle
  ElseIf PointHitTest(x0, y0, r, x1 * Px, y1 * Px, 2) Or PointHitTest(x0, y0, r, (x1 - 1) * Px, (y1 - 1) * Px, 2) Then
   'y0 = y1 * Px + Sqr(r * r - v * v)
   pBounceDown bStyle, vy
  End If
 End Select
End Select
End Sub

Private Sub pBounceUp(ByVal bStyle As Long, vy As Single, ByVal flrStyle As Long)
vy = -vy * IIf(flrStyle And &H80&, BounceQ - BounceQW, BounceQ)
'debug
xHitTest(1) = True
End Sub

Private Sub pBounceDown(ByVal bStyle As Long, vy As Single)
vy = -vy
'debug
xHitTest(2) = True
End Sub

Private Function SingleHitTest(x0 As Single, y0 As Single, ByVal r As Long, ByVal bStyle As Long, ByVal x1 As Long, ByVal y1 As Long, vx As Single, vy As Single, flrStyle As Long) As Boolean
Dim x As Long, y As Long
Dim st As Long, v As Single
x = Round(x0)
y = Round(y0)
st = d(x1, y1) And &HF
Select Case st
Case 0 'empty
Case 1, 2 'floor,???
 Select Case (d(x1, y1) And &H70) \ &H10
 Case 0
  SingleHitTest = True
  If LineHitTest(x, y, r, (x1 - 1) * Px, (y1 - 1) * Px, Px, 3, vx, vy) Then
   x0 = (x1 - 1) * Px - r
   vx = -vx * BounceQ
  ElseIf LineHitTest(x, y, r, x1 * Px, (y1 - 1) * Px, Px, 4, vx, vy) Then
   x0 = x1 * Px + r
   vx = -vx * BounceQ
  ElseIf LineHitTest(x, y, r, (x1 - 1) * Px, (y1 - 1) * Px, Px, 1, vx, vy) Then
   y0 = (y1 - 1) * Px - r
   flrStyle = st + (d(x1, y1) And &H80)
   pBounceUp bStyle, vy, flrStyle
  ElseIf LineHitTest(x, y, r, (x1 - 1) * Px, y1 * Px, Px, 2, vx, vy) Then
   y0 = y1 * Px + r
   pBounceDown bStyle, vy
  Else
   SingleHitTest = False
  End If
 Case 1 'TODO:position modify
  SingleHitTest = True
  If LineHitTest(x, y, r, x1 * Px, (y1 - 1) * Px, Px, 5, vx, vy) Then 'up-left
   v = vx
   vx = -vy * IIf(st = 2, BounceQ2, BounceQ)
   vy = v * BounceQ
   flrStyle = st + (d(x1, y1) And &H80)
   v = x0
   x0 = (x0 - y0 + x1 * Px + (y1 - 1) * Px) / 2 - Sqr2_2 * r
   y0 = (x1 * Px + (y1 - 1) * Px - v + y0) / 2 - Sqr2_2 * r
  ElseIf LineHitTest(x, y, r, x1 * Px, (y1 - 1) * Px, Px, 4, vx, vy) Then
   x0 = x1 * Px + r
   vx = -vx * BounceQ
  ElseIf LineHitTest(x, y, r, (x1 - 1) * Px, y1 * Px, Px, 2, vx, vy) Then
   y0 = y1 * Px + r
   pBounceDown bStyle, vy
  Else
   SingleHitTest = False
  End If
 Case 2 'TODO:position modify
  SingleHitTest = True
  If LineHitTest(x, y, r, (x1 - 1) * Px, (y1 - 1) * Px, Px, 8, vx, vy) Then
   v = vx
   vx = vy * IIf(st = 2, BounceQ2, BounceQ)
   vy = -v * BounceQ
   flrStyle = st + (d(x1, y1) And &H80)
   v = x0
   x0 = (x0 + y0 + x1 * Px - y1 * Px) / 2 + Sqr2_2 * r
   y0 = (v + y0 - x1 * Px + y1 * Px) / 2 - Sqr2_2 * r
  ElseIf LineHitTest(x, y, r, (x1 - 1) * Px, (y1 - 1) * Px, Px, 3, vx, vy) Then
   x0 = (x1 - 1) * Px - r
   vx = -vx * BounceQ
  ElseIf LineHitTest(x, y, r, (x1 - 1) * Px, y1 * Px, Px, 2, vx, vy) Then
   y0 = y1 * Px + r
   pBounceDown bStyle, vy
  Else
   SingleHitTest = False
  End If
 Case 3 'TODO:position modify
  SingleHitTest = True
  If LineHitTest(x, y, r, x1 * Px, (y1 - 1) * Px, Px, 6, vx, vy) Then
   v = vx
   vx = -vy * IIf(st = 2, BounceQ2, BounceQ) 'ERR
   vy = v * BounceQ2
   v = x0
   x0 = (x0 - y0 + x1 * Px + (y1 - 1) * Px) / 2 + Sqr2_2 * r
   y0 = (x1 * Px + (y1 - 1) * Px - v + y0) / 2 + Sqr2_2 * r
  ElseIf LineHitTest(x, y, r, (x1 - 1) * Px, (y1 - 1) * Px, Px, 1, vx, vy) Then
   y0 = (y1 - 1) * Px - r
   flrStyle = st + (d(x1, y1) And &H80)
   pBounceUp bStyle, vy, flrStyle
  ElseIf LineHitTest(x, y, r, (x1 - 1) * Px, (y1 - 1) * Px, Px, 3, vx, vy) Then
   x0 = (x1 - 1) * Px - r
   vx = -vx * BounceQ
  Else
   SingleHitTest = False
  End If
 Case 4 'TODO:position modify
  SingleHitTest = True
  If LineHitTest(x, y, r, (x1 - 1) * Px, (y1 - 1) * Px, Px, 7, vx, vy) Then
   v = vx
   vx = vy * IIf(st = 2, BounceQ2, BounceQ) 'ERR
   vy = -v * BounceQ2
   v = x0
   x0 = (x0 + y0 + x1 * Px - y1 * Px) / 2 - Sqr2_2 * r
   y0 = (v + y0 - x1 * Px + y1 * Px) / 2 + Sqr2_2 * r
  ElseIf LineHitTest(x, y, r, (x1 - 1) * Px, (y1 - 1) * Px, Px, 1, vx, vy) Then
   y0 = (y1 - 1) * Px - r
   flrStyle = st + (d(x1, y1) And &H80)
   pBounceUp bStyle, vy, flrStyle
  ElseIf LineHitTest(x, y, r, x1 * Px, (y1 - 1) * Px, Px, 4, vx, vy) Then
   x0 = x1 * Px + r
   vx = -vx * BounceQ
  Else
   SingleHitTest = False
  End If
 End Select
End Select
End Function

'Private Sub pHitTestSetSpeed(ByVal x1 As Long, ByVal y1 As Long, v As Single)
'Select Case d(x1, y1) And &HF
'Case 1, 2
' v = -v * IIf(d(x1, y1) And &H80, BounceQ - BounceQW, BounceQ)
''Case 2
'' v = -v * IIf(d(x1, y1) And &H80, BounceQ2 - BounceQW, BounceQ2)
'End Select
'End Sub
'
'Private Sub pHitTestSetSpeed2(ByVal x1 As Long, ByVal y1 As Long, v As Single)
'Select Case d(x1, y1) And &HF
'Case 1
' v = -v * IIf(d(x1, y1) And &H80, BounceQ - BounceQW, BounceQ)
''Case 2
'' v = -v * IIf(d(x1, y1) And &H80, BounceQ2 - BounceQW, BounceQ2)
'End Select
'End Sub

Private Function LineHitTest(ByVal x As Long, ByVal y As Long, ByVal r As Long, ByVal x1a As Long, ByVal y1a As Long, ByVal l As Long, ByVal Style As Long, ByVal vx As Single, ByVal vy As Single) As Boolean
'upper one=(x1a,y1a)
'
'Style=
'1 down
'2 up
'3 right
'4 left
'5 -> /
'6    / <-
'7 -> \
'8    \ <-
Select Case Style
Case 1
 If x >= x1a And x <= x1a + l And y < y1a And y > y1a - r And vy > 0 Then LineHitTest = True
Case 2
 If x >= x1a And x <= x1a + l And y < y1a + r And y > y1a And vy < 0 Then LineHitTest = True
Case 3
 If y >= y1a And y <= y1a + l And x < x1a And x > x1a - r And vx > 0 Then LineHitTest = True
Case 4
 If y >= y1a And y <= y1a + l And x < x1a + r And x > x1a And vx < 0 Then LineHitTest = True
Case 5
 If x - y <= x1a - y1a And x - y >= x1a - y1a - l * 2 And x + y > x1a + y1a - r * Sqr2 And x + y < x1a + y1a And vx + vy > 0 Then LineHitTest = True
Case 6
 If x - y <= x1a - y1a And x - y >= x1a - y1a - l * 2 And x + y > x1a + y1a And x + y < x1a + y1a + r * Sqr2 And vx + vy < 0 Then LineHitTest = True
Case 7
 If x + y >= x1a + y1a And x + y <= x1a + y1a + l * 2 And x - y > x1a - y1a - r * Sqr2 And x - y < x1a - y1a And vx > vy Then LineHitTest = True
Case 8
 If x + y >= x1a + y1a And x + y <= x1a + y1a + l * 2 And x - y > x1a - y1a And x - y < x1a - y1a + r * Sqr2 And vx < vy Then LineHitTest = True
End Select
'debug
If LineHitTest Then xHitTest(Style) = True
End Function

Private Function PointHitTest(x0 As Single, y0 As Single, ByVal r As Long, ByVal x1a As Long, ByVal y1a As Long, Optional ByVal z1 As Long) As Boolean
Dim x1 As Single, y1 As Single
x1 = Round(x0) - x1a
y1 = Round(y0) - y1a
Select Case z1
Case 0
 PointHitTest = x1 * x1 + y1 * y1 < r * r
Case 1
 PointHitTest = x1 * x1 + y1 * y1 < r * r And y1 < 0
Case 2
 PointHitTest = x1 * x1 + y1 * y1 < r * r And y1 > 0
End Select
If PointHitTest Then
 y0 = y1a + Sgn(y1) * Sqr(r * r - x1 * x1)
End If
End Function

Public Function ObjHitTest(ByVal x As Long, ByVal y As Long, ByVal r As Long) As Long
'
End Function

Public Function IsInWater(ByVal x As Long, ByVal y As Long, ByVal r As Long) As Boolean
'
End Function

Public Sub Create(ByVal x As Long, ByVal y As Long)
w = x
h = y
ReDim d(1 To w, 1 To h)
End Sub
